Ham Radio 2000 #1/Ham Radio 2000.iso/ham2000/packet/p_aa4re/bb212src/bbwinad.pas

Pascal/Delphi Source File | 1992-02-16 | 6.8 KB | 261 lines

(*===========================================================================*)
(* Activate/deactivate/swap the window                                       *)
(*                                                                           *)
(*   Copyright 1988, 1989, 1991 by H. Roy Engehausen.  All rights reserved.  *)
(*                                                                           *)
(*===========================================================================*)

(*===========================================================================*)
(* Activate a window                                                         *)
(*===========================================================================*)

PROCEDURE window_activate(window_number:BYTE);
  BEGIN;

    IF window_number <> window_operator THEN
      BEGIN;
        WRITELN('Can''t activate ', window_number);
        HALT;
      END;

    window_number :=
                  who_is_in_window(window_array[window_operator].window_loc);

    window_array[window_number].window_act  := FALSE;
    window_array[window_operator].window_act := TRUE;

    window_select(window_operator);

    CLRSCR;

    window_refresh(window_operator);

    WITH window_array[current_window] DO
      GOTOXY(window_cursor, window_location[window_loc].window_wl);

    status_window_change := TRUE;

  END;

(*===========================================================================*)
(* Deactivate a window                                                      *)
(*===========================================================================*)

PROCEDURE window_deactivate(window_number:BYTE);
  BEGIN;

    IF window_number <> window_operator THEN
      BEGIN;
        WRITELN('Can''t deactivate ', window_number);
        HALT;
      END;

    window_number :=
                  who_is_in_window(window_array[window_operator].window_loc);

    window_array[window_operator].window_act := FALSE;
    window_array[window_number].window_act   := TRUE;

    window_select(window_number);
    CLRSCR;

    window_refresh(window_number);

    WITH window_array[current_window] DO
      GOTOXY(window_cursor, window_location[window_loc].window_wl);

    status_window_change := TRUE;
  END;

(*===========================================================================*)
(* Window select                                                             *)
(*===========================================================================*)

PROCEDURE window_select(window_number : BYTE);

  BEGIN;

    {$IFDEF DEBUG}
      WRITELN('WS - ', window_number);
      DELAY(1000);
    {$ENDIF}

    window_array[current_window].window_cursor := WHEREX;

    IF current_window = window_reset THEN
      reset_window_y := WHEREY;

    current_window := window_number;

    WITH window_array[current_window] DO
      BEGIN;

        IF NOT window_act THEN
          EXIT;

        {$IFDEF DEBUG}
          WRITELN('WINDOW COORD - ', window_number);
          DELAY(1000);
        {$ENDIF}

        WITH window_location[window_loc] DO
          BEGIN;

            {$IFDEF DEBUG}
              WRITELN('WINDOW COORD - ', window_u_y, '/', window_l_y);
              DELAY(1000);
            {$ENDIF}

            WINDOW( 1, window_u_y,
                   80, window_l_y);

            {$IFDEF DEBUG}
              WRITELN('WINDOW CURSOR - ', window_wl);
              DELAY(1000);
            {$ENDIF}

            IF window_number <> window_reset THEN
              GOTOXY(window_cursor, window_wl)
            ELSE
              GOTOXY(window_cursor, reset_window_y);
          END;

        {$IFDEF DEBUG}
          WRITELN('WINDOW color - ', active_tcb^.w_color);
          DELAY(1000);
        {$ENDIF}

        COLOR(active_tcb^.w_color);

        {$IFDEF DEBUG}
          WRITELN('WS end', active_tcb^.w_color);
          DELAY(1000);
        {$ENDIF}

      END;

  END;

(*===========================================================================*)
(* Window swap                                                               *)
(*===========================================================================*)

PROCEDURE window_swap;

  VAR
    b      : BOOLEAN;
    w_1_no : BYTE;
    w_2_no : BYTE;

  BEGIN;

    w_1_no := who_is_in_window(window_top_screen);
    w_2_no := who_is_in_window(window_bottom_screen);

    WITH window_array[w_1_no] DO
      BEGIN;
        window_loc := window_bottom_screen;
        window_act := window_array[w_2_no].window_act;
        b          := window_act;
      END;

    WITH window_array[w_2_no] DO
      BEGIN;
        window_loc := window_top_screen;
        window_act := TRUE;
      END;

    status_window_change := TRUE;

    window_select(w_2_no);
    CLRSCR;
    window_refresh(w_2_no);

    IF NOT b THEN EXIT;

    window_select(w_1_no);
    CLRSCR;
    window_refresh(w_1_no);

    window_select(window_reset);

  END;

(*===========================================================================*)
(* Window clear                                                              *)
(*===========================================================================*)

PROCEDURE window_clear(window_number : BYTE);

  VAR
    w_work : window_data_ptr;
    w_next : window_data_ptr;

  BEGIN;

    window_select(window_number);
    CLRSCR;

    WITH window_array[window_number] DO
      BEGIN;

        IF NOT window_scrollable THEN
          EXIT;

        w_work := window_last;

        REPEAT

          w_next := w_work^.last_line;

          {$IFDEF LOOP_POINT_CHK}
            IF w_next = w_work THEN
              BEGIN;
                WRITELN('Window loop put wind ');
                dump_string('Wind loop at put wind ' + p2x(w_work));
                dump_window(current_window);
                HALT;
              END;
          {$ENDIF}

          IF w_next <> NIL THEN
            BEGIN;

              {$IFDEF POINT_CHK}
                test_pointer(w_work);
                test_pointer(w_next);
              {$ENDIF}

              DISPOSE(w_work);

              {$IFDEF FREE_CHK}
                test_free_list;
              {$ENDIF}

              w_work := w_next;

            END;

        UNTIL w_next = NIL;

        {$IFDEF POINT_CHK}
          test_pointer(w_work);
        {$ENDIF}

        WITH w_work^ DO
          BEGIN;
            last_line  := NIL;
            next_line  := NIL;
            this_line  := '';
            line_color := invisible_color;
          END;

        window_data       := w_work;
        window_count      := 0;
        window_line       := w_work;
        window_last       := w_work;

      END;

  END;